home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 July / macformat-039.iso / Internet Essentials / Internet Shareware / NetPresenz-401 / CGI Examples / index / index.cgi / index.cgi.rsrc / TEXT_128_!.txt < prev    next >
Encoding:
Text File  |  1996-02-01  |  2.6 KB  |  169 lines
  1. #!perl
  2.  
  3.  
  4. # index.cgi
  5.  
  6. # Displays an index of the directory
  7. #
  8. # by Mark Tearle 1996
  9. # Stairways Software Pty Ltd
  10. #
  11. # Email: <mtearle@stairways.com.au>
  12. #
  13. # This script based on code by Peter Lewis and the PCGI example
  14. #
  15.  
  16. # You will need to change this, if you put index.cgi in the root directory of your web site this can 
  17. # just be ""
  18.  
  19. $rootdir="Crazy:Pub:CGI Examples";
  20.  
  21. sub unixpath2macpath {
  22.   local($path) = @_;
  23.  
  24.   $path =~ tr+/+:+;
  25.      # $path = ":$path";
  26.         $path;
  27. }
  28.  
  29.  
  30. sub getlocallisting {
  31.   local($base) = @_;
  32.   local(@list,$file,@names);
  33.  
  34.  
  35.         if ($base eq "/") {
  36.             $base = "";
  37.         }
  38.  
  39.         chdir &unixpath2macpath($base) || die "Couldn't change directory $!";;
  40.  
  41.   @list = ();
  42.   opendir(DIR, &unixpath2macpath($base)) || die "Couldn't open directory $!";
  43.   @names = readdir(DIR);
  44.   closedir(DIR);
  45.   foreach $name (@names) {
  46.     next if $name =~ /^\./;
  47.     $file = "$name";
  48.              push(@list,"$file");
  49.  
  50.   }
  51.  
  52.   @list;
  53. }
  54.  
  55. sub getbasename {
  56.         local ($tmp);
  57.  
  58.     $tmp = $ENV{"SCRIPT_NAME"};
  59.     $tmp =~ /(.*)\/(.*)/;
  60.  
  61.     $tmp = $1;
  62.     if ($tmp eq "") {
  63.         $tmp="/";
  64.     } else {
  65.         $tmp="$tmp/";
  66.     }
  67. }
  68.  
  69. sub getparent {
  70.         local ($tmp) = @_;
  71.  
  72.     $tmp =~ /(.*)\/(.*)/;
  73.  
  74.     $tmp = $1;
  75.     if ($tmp eq "") {
  76.         $tmp="/";
  77.     } else {
  78.         $tmp="$tmp/";
  79.     }
  80. }
  81.  
  82.  
  83. $servername = "NetPresenz/4.0";
  84.  
  85.       $eol = "\015\012"; # Give CRLF terminated headers
  86.  
  87. if ($header) {
  88.    print "HTTP/1.0 200 OK$eol";
  89.    print "Server: ";
  90.             print $servername;
  91.             print "$eol";
  92.    print "MIME-Version: 1.0$eol";
  93. }
  94. print "Content-Type: text/html$eol$eol";
  95.  
  96.  
  97. $basename = &getbasename();
  98.  
  99.  
  100. print"<HEAD><TITLE>http://";
  101.         print $ENV{"SERVER_NAME"};
  102.         if ($ENV{"SERVER_PORT"} ne "80") {
  103.             print ":";
  104.             print $ENV{"SERVER_PORT"};
  105.         }
  106.         print "$basename";
  107.  
  108. print <<END_HEADER; 
  109. </TITLE></HEAD>
  110.  
  111. <BODY>
  112. <PRE>
  113. END_HEADER
  114.  
  115.  
  116.  
  117. print "<H2>Index of $basename</H2>$eol";
  118. print "<UL>$eol";
  119.  
  120. if ($rootdir eq "") {
  121.     $rootdir=`pwd`;
  122.     chomp $rootdir;
  123. }
  124.  
  125. $dirname="$rootdir$basename";
  126.  
  127. @locallist = &getlocallisting($dirname);
  128. foreach $i (sort @locallist) {
  129.         print "<LI>";
  130.         print "<A HREF=\"http://";
  131.         print $ENV{"SERVER_NAME"};
  132.         if ($ENV{"SERVER_PORT"} ne "80") {
  133.             print ":";
  134.             print $ENV{"SERVER_PORT"};
  135.         }
  136.         print "$basename";
  137.         print "$i\">";
  138.         print "$i";
  139.         print "</A>$eol";
  140. }
  141.  
  142. if ($basename ne "/") {
  143.         $mytmp = $basename;
  144.         chop $mytmp;
  145.             print "<LI>";
  146.         print "<A HREF=\"http://";
  147.         print $ENV{"SERVER_NAME"};
  148.         if ($ENV{"SERVER_PORT"} ne "80") {
  149.             print ":";
  150.             print $ENV{"SERVER_PORT"};
  151.         }
  152.         print &getparent($mytmp);
  153.         print "\">";
  154.         print "<I>Parent Directory</I>";
  155.         print "</A>$eol";
  156. }
  157.  
  158. print "</UL>$eol";
  159.  
  160. print "<I>";
  161. print $servername;
  162. print "</I>$eol";
  163.  
  164. print <<END_FOOTER;
  165. </PRE>
  166. </BODY>
  167. END_FOOTER
  168.  
  169.